home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / PROGBLER / WHIZZARD.LZH / BANDDEMO.BAS < prev    next >
BASIC Source File  |  1984-07-06  |  13KB  |  332 lines
  1. 10  REM
  2. 20  REM BANDDEMO      date: June 16, 1984
  3. 30  REM
  4. 40  REM Demonstrate advantages of ASMBASIC versus standard BASICA print
  5. 50  REM statements.
  6. 60  REM
  7. 70  REM This program is written for running under BASICA version 2.0,
  8. 80  REM with Rayhawk Automation NW  ASMBASIC.EXE previously executed to
  9. 90  REM provide assembler interfaces to the IBM PC ROM screen drivers.
  10. 100 REM
  11. 110 REM Throughput is demonstrated to speed up by a factor of 5 by
  12. 120 REM bypassing the BASIC PRINT statement.  Using Rayhawk Automation
  13. 130 REM BASPRINT.EXE the same result can be accomplished for interpreted
  14. 131 REM BASIC programs.
  15. 132 REM
  16. 133 REM ****** The real program starts at 2000
  17. 135 REM
  18. 140 REM If your program just uses PRINT statements just execute
  19. 142 REM
  20. 144 REM BASPRINT.EXE for interpreted BASIC on the IBM
  21. 148 REM COMPRINT.EXE for compiled BASIC, compiled without the /O option
  22. 152 REM PRSLASHO.EXE for compiled BASIC, compiled with the /O option
  23. 160 REM
  24. 162 REM If your interpreted program uses the QPRINT subroutine from ASMBASIC
  25. 164 REM then lines 190 and 250 to 860 must be executed in your program.
  26. 166 REM ASMBASIC.EXE must be run once every time you boot, ( use AUTOEXEC.BAT),
  27. 168 REM the PC.  Then it will be in memory ready to be used by your program.
  28. 170 REM If your compiled program uses the QPRINT subroutine then link it using
  29. 172 REM QPRINT.OBJ.  This is supplied with the diskette so that you do not need
  30. 174 REM the assembler to process QPRINT.ASM.
  31. 178 REM
  32. 180    DIM A$(20),T$(20)
  33. 190    DEFINT S,I
  34. 192    DIM IIA(40)
  35. 200    KEY OFF
  36. 210    FOR I = 1 TO 10
  37. 220       KEY I,""
  38. 230    NEXT I
  39. 240 REM
  40. 242 REM Determine whether we are running compiled or interpreted
  41. 244 REM          FLAG% = 0     if interpreted
  42. 246 REM          FLAG% = 1     if compiled without /O (needs BASRUN.EXE)
  43. 247 REM          FLAG% = 2     if compiled with /O
  44. 248 REM          FLAG% = 3     if business basic compiled
  45. 249 REM
  46. 250   DEF SEG
  47. 260   TEST$ = "K"
  48. 270   A% = VARPTR(TEST$)
  49. 280    B% = PEEK(A%+1) + 256*PEEK(A%+2)
  50. 290     IF CHR$(PEEK(B%)) = "K" THEN FLAG% = 0 : GOTO 360
  51. 300    B% = PEEK(A%+2) + 256*PEEK(A%+3)
  52. 310     IF CHR$(PEEK(B%)) <> "K" THEN FLAG% = 3 : GOTO 880
  53. 312      WIDTH 80 : IF PEEK(&H7CC) = 80 THEN FLAG% = 1   ELSE FLAG% = 2
  54. 320       GOTO 880
  55. 330 REM
  56. 340 REM If interpreted, check that ASMBASIC is resident below the interpreter
  57. 350 REM
  58. 360  DEF SEG = 0
  59. 370  A% = PEEK(&H19C) + 256*PEEK(&H19D) : B% = PEEK(&H19E) + 256*PEEK(&H19F)
  60. 380    DEF SEG = B%
  61. 390    IF (PEEK(A%-1) = &H52) AND (PEEK(A%-2) = &H52) THEN ASM%=1:GOTO 470
  62. 400      CLS : PRINT TAB(85);"ASMBASIC must be executed once before starting"
  63. 410        PRINT TAB(15);"the Basic interpreter"
  64. 420      ASM% = 0
  65. 430      GOTO 880
  66. 440 REM
  67. 450 REM If interpreted, then get the segment and offset of the utility routines
  68. 460 REM
  69. 470    DEF SEG
  70. 480    DIM INIT%(3)           ' setup subroutine containing  INT  67h
  71. 490    INIT%(1) = &H67CD       '                              RETF 2
  72. 500    INIT%(2) = &H2CA
  73. 510    INIT%(3) = 0
  74. 520    SUBINIT = 0
  75. 530 REM
  76. 540 REM         get the code segment of the utility subroutines
  77. 550  SEGVALUE% = 0
  78. 560    SUBINIT = VARPTR(INIT%(1)): CALL SUBINIT(SEGVALUE%)
  79. 570 REM
  80. 580 REM         get the offset of the utility subroutines
  81. 590  A% = 1
  82. 600    SUBINIT = VARPTR(INIT%(1)):CALL SUBINIT(A%)
  83. 610     QPRINT = A%
  84. 620  A% = 2
  85. 630    SUBINIT = VARPTR(INIT%(1)):CALL SUBINIT(A%)
  86. 640     SCRLDN = A%
  87. 650  A% = 3
  88. 660    SUBINIT = VARPTR(INIT%(1)):CALL SUBINIT(A%)
  89. 670     SCRLUP = A%
  90. 680  A% = 4
  91. 690    SUBINIT = VARPTR(INIT%(1)):CALL SUBINIT(A%)
  92. 700     XREP = A%
  93. 710  A% = 5
  94. 720    SUBINIT = VARPTR(INIT%(1)):CALL SUBINIT(A%)
  95. 730     YREP = A%
  96. 740  A% = 6
  97. 750    SUBINIT = VARPTR(INIT%(1)):CALL SUBINIT(A%)
  98. 760     CLREOL = A%
  99. 770  A% = 7
  100. 780    SUBINIT = VARPTR(INIT%(1)):CALL SUBINIT(A%)
  101. 790     CLREOS = A%
  102. 800  A% = 8
  103. 810    SUBINIT = VARPTR(INIT%(1)):CALL SUBINIT(A%)
  104. 820     ZPRINT = A%
  105. 830 REM
  106. 840 REM         set the segment value for interpreted basic
  107. 845 REM         this is used by BASIC for all interpreted CALLs to QPRINT,
  108. 848 REM         SCRLDN, etc. and must be valid prior to each such CALL.
  109. 850 REM
  110. 860     DEF SEG = SEGVALUE%
  111. 870 REM
  112. 880 REM  define some attributes for use throughout the demo
  113. 890     IF FLAG% = 0 THEN GOTO 930 ELSE DEF SEG
  114. 900     ' check for comprint or prslasho, prslasho will be in the demo
  115. 910    '  if 40 lines take less than 2 seconds comprint or prslasho is here
  116. 915     CLS   ' first initialize comprint or prslasho if compiled !!!!!!!
  117. 920     STARTTIME$=TIME$
  118. 922     FOR I = 1 TO 40:
  119. 923       LOCATE 1,1:PRINT " TESTING IF COMPRINT OR PRSLASHO ARE PRESENT"
  120. 924     NEXT I
  121. 927     ENDTIME$ = TIME$
  122. 928     GOSUB 2840: IF DIFTIME# < 2! THEN BASPRINT%=1 ELSE BASPRINT% = 0
  123. 929 GOTO 1000
  124. 930     DEF SEG = 0  ' interpreted, check for basprint
  125. 940     B02D0% = PEEK(&H2D0):B02D1%=PEEK(&H2D1):B02D2%=PEEK(&H2D2):B02D3%=PEEK(&H2D3)
  126. 950 '    PRINT " CHECKING FOR BASPRINT  0:02D0 = ";HEX$(B02D1%);" ";HEX$(B02D0%);" ";HEX$(B02D3%);" ";HEX$(B02D2%)
  127. 960     IF B02D1% = 0 THEN BASPRINT% = 1 ELSE BASPRINT% = 0
  128. 962 ' if ASMBASIC has been run, then restore the DEF SEG value so ASMBASIC
  129. 964 ' routines can be used
  130. 970     IF ASM% =1 THEN  DEF SEG = SEGVALUE% ELSE DEF SEG
  131. 980 REM
  132. 990 REM
  133. 1000    IF FLAG% = 0 THEN PRINT " INTERPRETED "
  134. 1010    IF FLAG% = 1 THEN PRINT " COMPILED WITHOUT /O, NEEDS BASRUN.EXE "
  135. 1012    IF FLAG% = 1 THEN PRINT " COMPILED WITH /O "
  136. 1020    IF FLAG% = 3 THEN PRINT " BUSINESS BASIC COMPILED "
  137. 1030    IF FLAG% = 0 AND ASM% = 0 THEN PRINT " ASMBASIC NOT PRESENT"
  138. 1040    IF FLAG% = 0 AND ASM% = 1 THEN PRINT " ASMBASIC PRESENT"
  139. 1050    IF FLAG% > 0 AND BASPRINT% = 0 THEN PRINT " COMPRINT OR PRSLASHO ARE NOT PRESENT "
  140. 1060    IF FLAG% > 0 AND BASPRINT% = 1 THEN PRINT " COMPRINT OR PRSLASHO ARE PRESENT"
  141. 1070    IF FLAG% = 0 AND BASPRINT% = 0 THEN PRINT " BASPRINT NOT PRESENT"
  142. 1080    IF FLAG% = 0 AND BASPRINT% = 1 THEN PRINT " BASPRINT PRESENT"
  143. 1095  ' while inkey$ <> "":wend
  144. 1100  ' input " enter to continue ";junk$
  145. 1110  ' CLS : LOCATE 4,4 : INPUT "Would you like the demonstration in color (Y/N)";AA$
  146. 1112    AA$="N"
  147. 1120    IF AA$ = "Y" OR AA$ = "y" THEN 1320
  148. 1130    IF AA$ <> "N" AND AA$ <> "n" THEN 1080
  149. 1140 REM
  150. 1150 REM    black and white attributes
  151. 1160 REM
  152. 1170    NORMAL%  = 7   ' normal intensity white on black
  153. 1180    BLUE%     = 7
  154. 1190    GREEN%     = 7
  155. 1200    CYAN%     = 7
  156. 1210    RED%     = 7
  157. 1220    MAGENTA% = 7
  158. 1230    BROWN%     = 7
  159. 1240    YELLOW%  = 7
  160. 1250    WHITE%     = 15  ' high intensity white on black
  161. 1260    LIGHTER% = 7
  162. 1270    BLINK%     = 128
  163. 1280        GOTO 1570
  164. 1290 REM
  165. 1300 REM    color attributes
  166. 1310 REM
  167. 1320    NORMAL%  = 7   ' normal intensity white on black
  168. 1330    BLUE%     = 1
  169. 1340    GREEN%     = 2
  170. 1350    CYAN%     = 3
  171. 1360    RED%     = 4
  172. 1370    MAGENTA% = 5
  173. 1380    BROWN%     = 6
  174. 1390    YELLOW%  = 14
  175. 1400    WHITE%     = 15  ' high intensity white on black
  176. 1410 REM
  177. 1420 REM  To make a color lighter, logically OR the LIGHTER% with
  178. 1430 REM    the color.
  179. 1440 REM         Ex:      ATTRIBUTE% = RED% OR LIGHTER%
  180. 1450 REM    will give a light red color.
  181. 1460 REM
  182. 1470           LIGHTER% = 8
  183. 1480 REM
  184. 1490 REM  To make a color blink, logically OR the BLINK% with
  185. 1500 REM    the color.
  186. 1510 REM         Ex:      ATTRIBUTE% = RED% OR BLINK%
  187. 1520 REM    will give a blinking red color.
  188. 1530 REM
  189. 1540           BLINK% = 128
  190. 1550 REM
  191. 1560 REM
  192. 1570 REM
  193. 1580 REM
  194. 1600 REM
  195. 2000 REM *************    The real program starts here
  196. 2010 REM
  197. 2015 REM Show how slow standard BASIC print statements are.
  198. 2020 REM Print A$(1) TO A$(5) in boxes, with origins in the array IIA(40)
  199. 2030 REM
  200. 2040 REM Then show how fast ASMBASIC routines QPRINT is.  This is also how
  201. 2050 REM fast BASPRINT makes the routines
  202. 2060 REM
  203. 2070 REM If BASPRINT is resident, then do not use A$(1) contents as STANDARD
  204. 2080 REM BASIC, use A$ to show how fast BASPRINT is.
  205. 2100 RESTORE 2110
  206. 2101 IWRITES = 11:IJ=0
  207. 2102 FOR I = 1 TO IWRITES:IJ=IJ+1:READ IIA(IJ):IJ=IJ+1:READ IIA(IJ):NEXT I
  208. 2110 DATA 7,27,1,1,1,27,1,55,7,55,13,55,19,55,19,27,19,1,13,1,7,1
  209. 2125 BLANKIT$=SPACE$(25)
  210. 2130 CLS
  211. 2135 AA$="HIT ANY KEY TO STOP THE DEMO"
  212. 2140 LOCATE 15,27:
  213. 2150 IF FLAG%>0 OR ASM% = 1 THEN CALL QPRINT (FLAG%, AA$)  ELSE PRINT AA$;
  214. 2190 IF FLAG% = 0 AND BASPRINT% = 0 THEN GOTO 2210
  215. 2200 IF FLAG% = 0 AND BASPRINT% = 1 THEN GOTO 3200
  216. 2205 IF FLAG% > 0 AND BASPRINT% = 1 THEN GOTO 4200
  217. 2206 IF FLAG% > 0 AND BASPRINT% = 0 THEN GOTO 5200
  218. 2210 '  interpreted with ASMBASIC present, but BASPRINT is not present
  219. 2220 '  this means slow slow BASIC print statements
  220. 2230 A$(1)="*************************"
  221. 2231 A$(2)="*   GET OFF THE SLOW    *"
  222. 2232 A$(3)="*    MERRY-GO-ROUND     *"
  223. 2233 A$(4)="* OF INTERPRETED BASIC  *"
  224. 2234 A$(5)="*   PRINT STATEMENTS    *"
  225. 2235 A$(6)="*************************"
  226. 2240 GOSUB 6000 ' use PRINT
  227. 2250 IF ASM% = 1 THEN GOSUB 2400 ' set up and use QPRINT if ASMBASIC has run
  228. 2255 IF INKEY$ <> "" THEN SYSTEM
  229. 2260 GOTO  2210 ' infinite loop
  230. 2400 ' SHOW HOW FAST ASMBASIC STATEMENTS ARE
  231. 2425 BLANKIT$=SPACE$(25)
  232. 2430 A$(1)="*************************"
  233. 2431 A$(2)="*      GET ON THE       *"
  234. 2432 A$(3)="*      BANDWAGON        *"
  235. 2433 A$(4)="* WITH CLUBware ASMBASIC*"
  236. 2434 A$(5)="*    QPRINT STATEMENTS  *"
  237. 2435 A$(6)="*************************"
  238. 2440 IF FLAG% = 0 THEN ILOOP = 5 ELSE ILOOP = 10
  239. 2450 FOR IB = 1 TO ILOOP
  240. 2460  GOSUB 6200
  241. 2470 NEXT IB
  242. 2480 RETURN
  243. 2840 REM TIMING SUBROUTINE
  244. 2850 REM  inputs:  STARTTIME$
  245. 2860 REM        ENDTIME$
  246. 2870 REM  output:  DIFTIME#     time in seconds
  247. 2880   SHH#=VAL(LEFT$(STARTTIME$,2))
  248. 2890   EHH#=VAL(LEFT$(ENDTIME$,2))
  249. 2900   SSS#=VAL(RIGHT$(STARTTIME$,2))
  250. 2910   ESS#=VAL(RIGHT$(ENDTIME$,2))
  251. 2920   SMM#=VAL(MID$(STARTTIME$,4,2))
  252. 2930   EMM#=VAL(MID$(ENDTIME$,4,2))
  253. 2940   STIME#=SHH#*3600!+SMM#*60!+SSS#
  254. 2950   ETIME#=EHH#*3600!+EMM#*60!+ESS#
  255. 2960   DIFTIME#=ETIME#-STIME#
  256. 2970   IF DIFTIME# < 0! THEN DIFTIME#= DIFTIME# + 3600! * 24!
  257. 2980 RETURN
  258. 2990 REM
  259. 3200 ' SHOW HOW FAST BASPRINT SPEEDS UP INTERPRETED BASIC PRINT STATEMENTS
  260. 3225   BLANKIT$=SPACE$(25)
  261. 3230   A$(1)="*************************"
  262. 3231   A$(2)="* CLUBware BASPRINT.EXE *"
  263. 3232   A$(3)="*       speeds up       *"
  264. 3233   A$(4)="*    Interpreted BASIC  *"
  265. 3234   A$(5)="*     PRINTs 6 times    *"
  266. 3235   A$(6)="*************************"
  267. 3250   FOR IB = 1 TO 5
  268. 3260     GOSUB 6000  ' use print statements around the screen
  269. 3270   NEXT IB
  270. 3280   IF ASM%=1 THEN GOSUB 2400 ' use QPRINT calls around the screen
  271. 3300   GOTO 3200 ' infinite loop
  272. 3310 REM
  273. 4200 ' SHOW HOW FAST PRSLASHO or COMPRINT SPEEDS UP COMPILED BASIC PRINTS
  274. 4225   BLANKIT$=SPACE$(25)
  275. 4230   A$(1)="*************************"
  276. 4231   A$(2)="* CLUBware PRSLASHO.EXE *"
  277. 4232   A$(3)="*       speeds up       *"
  278. 4233   A$(4)="*     Compiled BASIC    *"
  279. 4234   A$(5)="*     PRINTs 6 times    *"
  280. 4235   A$(6)="*************************"
  281. 4236   IF FLAG% = 1 THEN A$(2)="* CLUBware COMPRINT.EXE *"
  282. 4250   FOR IB = 1 TO 5
  283. 4260     GOSUB 6000 ' use print statements around the screen
  284. 4262   IF INKEY$ <> "" THEN SYSTEM
  285. 4270   NEXT IB
  286. 4275   GOSUB 2400   ' use QPRINT statements around the screen
  287. 4285   IF INKEY$ <> "" THEN SYSTEM
  288. 4300   GOTO 4200 ' infinite loop
  289. 4310 REM
  290. 5200 ' compiled BASIC, COMPRINT or PRSLASHO not present.
  291. 5220 ' this means slow slow BASIC print statements
  292. 5230   A$(1)="*************************"
  293. 5231   A$(2)="*   GET OFF THE SLOW    *"
  294. 5232   A$(3)="*     MERRYGOROUND      *"
  295. 5233   A$(4)="*   OF COMPILED BASIC   *"
  296. 5234   A$(5)="*   PRINT STATEMENTS    *"
  297. 5235   A$(6)="*************************"
  298. 5240   GOSUB 6000 ' use PRINT
  299. 5250   GOSUB 2400 ' set up and use QPRINT
  300. 5255   IF INKEY$ <> "" THEN SYSTEM
  301. 5260 GOTO  5200 ' infinite loop
  302. 5270 REM
  303. 6000 REM  ' use standard BASIC PRINT statements - slow, slower, slowest
  304. 6036   FOR I = 1 TO IWRITES
  305. 6040     IROW = IIA(I+I-1)
  306. 6050     ICOL = IIA(I+I)
  307. 6060     FOR IJ = 1 TO 6:LOCATE IROW,ICOL:PRINT A$(IJ);:IROW = IROW+1:NEXT IJ
  308. 6080     IK = I-1
  309. 6090     IF I = 1 THEN IK = IWRITES
  310. 6092     IF I = 2 THEN GOTO 6150 ' leave the center statement
  311. 6100     IROW = IIA(IK+IK-1)
  312. 6110     ICOL = IIA(IK+IK)
  313. 6120     FOR IJ = 1 TO 6:LOCATE IROW,ICOL:PRINT BLANKIT$;:IROW = IROW+1:NEXT IJ
  314. 6142     IF INKEY$ <> "" THEN SYSTEM
  315. 6150   NEXT I
  316. 6160 RETURN
  317. 6170 REM
  318. 6200 REM  ' use ASMBASIC QPRINT statements
  319. 6236   FOR I = 1 TO IWRITES
  320. 6240     IROW = IIA(I+I-1)
  321. 6250     ICOL = IIA(I+I)
  322. 6254     FOR IJ = 1 TO 6:LOCATE IROW,ICOL:CALL QPRINT (FLAG%, A$(IJ)):IROW=IROW+1:NEXT IJ
  323. 6280     IK = I-1
  324. 6290     IF I = 1 THEN IK = IWRITES
  325. 6292     IF I = 2 THEN GOTO 6350 ' leave the center statement
  326. 6300     IROW = IIA(IK+IK-1)
  327. 6310     ICOL = IIA(IK+IK)
  328. 6320     FOR IJ = 1 TO 6:LOCATE IROW,ICOL:CALL QPRINT (FLAG%, BLANKIT$):IROW=IROW+1:NEXT IJ
  329. 6342     IF INKEY$ <> "" THEN SYSTEM
  330. 6350   NEXT I
  331. 6360 RETURN
  332.